unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls, Menus;

type
        sim=record
                people:integer;
                cars:integer;
        end;
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    MainMenu1: TMainMenu;
    Data1: TMenuItem;
    Save1: TMenuItem;
    Load1: TMenuItem;
    Clear1: TMenuItem;
    RunSimulation1: TMenuItem;
    Maximise1: TMenuItem;
    SaveDialog2: TSaveDialog;
    FontDialog1: TFontDialog;
    PrintDialog1: TPrintDialog;
    PrinterSetupDialog1: TPrinterSetupDialog;
    N1: TMenuItem;
    Print1: TMenuItem;
    Exit1: TMenuItem;
    Layout1: TMenuItem;
    Colours1: TMenuItem;
    Fonts1: TMenuItem;
    PrintSetup1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Load1Click(Sender: TObject);
    procedure Clear1Click(Sender: TObject);
    procedure Maximise1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Colours1Click(Sender: TObject);
    procedure StringGrid1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
        simarray:array[0..23] of sim;
        ErrCodes:array[1..99] of string;
        ErrNum:integer;
        Colours:array[0..4] of TColor;
  end;

const
        Buttons=0;
        StringGrid=1;
        Cars=2;
        People=3;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

function floattoint(val:real):integer;
var
        i:integer;
        s1,s2,s3:string;
        done:boolean;
begin
        s1:=floattostr(val);
        done:=false;
        for i:=1 to length(s1) do
        begin
                if done=false then
                begin
                        s2:=s1[i];
                        if s2<>'.' then
                        begin
                                s3:=s3+s2;
                        end
                        else
                        begin
                                done:=true;
                        end;
                end;
        end;
        floattoint:=strtoint(s3);
end;

procedure DispErr(Code:integer);
var
        i:integer;
        Stri:string;
begin
        Form1.ErrCodes[1]:='Integer Expected!';
        Form1.ErrCodes[2]:='File Error';
        Form1.ErrCodes[4]:='Real Found (Converted).';
        Form1.ErrCodes[8]:='Data not saved.';
        Form1.ErrCodes[16]:='Letter Found!';
        i:=16;
        Stri:='';
        repeat
                if Code>=i then
                begin
                        Code:=Code-i;
                        Stri:=Stri+chr(10)+chr(13)+Form1.ErrCodes[i];
                end;
                i:=floattoint(i/2);
        until i=0;
        i:=messagedlg (Stri,mtWarning,mbOkCancel,0);
end;

procedure UpdateCols;
begin
        
end;

procedure UpdateDisplay;
var
        k:integer;
begin
        for k:=1 to 24 do
        begin
                form1.stringgrid1.cells[k,1]:=inttostr(form1.simarray[k-1].cars);
                form1.stringgrid1.cells[k,2]:=inttostr(form1.simarray[k-1].people);
        end;
end;

procedure FillSpace;
var
        k:integer;
begin
        for k:=1 to 24 do
        begin
                if form1.stringgrid1.cells[k,1]='' then
                begin
                        form1.stringgrid1.cells[k,1]:='0';
                end;
                if form1.stringgrid1.cells[k,2]='' then
                begin
                        form1.stringgrid1.cells[k,2]:='0';
                end;
        end;
end;

procedure UpdateArray;
var
        k:integer;
        Err:boolean;
begin
        form1.ErrNum:=0;
        for k:=0 to 23 do
        begin
                if form1.stringgrid1.cells[k+1,1]<>'' then
                begin
                        Err:=false;
                        try
                                form1.simarray[k].cars:=strtoint(form1.stringgrid1.cells[k+1,1]);
                        except
                                Err:=true;
                        end;
                        if Err=true then
                        begin
                                try
                                        form1.simarray[k].cars:=floattoint(strtofloat(form1.stringgrid1.cells[k+1,1]));
                                except
                                        //error! space in cars is not a number
                                        form1.ErrNum:=1+16;
                                end;
                                if form1.ErrNum=0 then form1.ErrNum:=1+4;
                        end;
                end
                else
                begin
                        //empty space, assume 0
                        form1.simarray[k].cars:=0;
                end;

                if form1.stringgrid1.cells[k+1,2]<>'' then
                begin
                        try
                                form1.simarray[k].people:=strtoint(form1.stringgrid1.cells[k+1,2]);
                        except
                                Err:=true;
                        end;
                        if Err=true then
                        begin
                                try
                                        form1.simarray[k].people:=floattoint(strtofloat(form1.stringgrid1.cells[k+1,2]));
                                except
                                        //error! space in people is not a number
                                        form1.ErrNum:=1+16;
                                end;
                                if form1.ErrNum=0 then form1.ErrNum:=1+4;
                        end;
                end
                else
                begin
                        //empty space, assume 0
                        form1.simarray[k].people:=0;
                end;
        end;
        if Form1.ErrNum<>0 then
                DispErr(form1.ErrNum);
        UpdateDisplay;
end;

procedure ClearData;
var
        k:integer;
begin
        for k:= 0 to 23 do
        begin
                Form1.SimArray[k].cars:=0;
                Form1.SimArray[k].people:=0;
        end;
        UpdateDisplay;
end;

procedure LoadData;
var
        k:integer;
        simfile:textfile;
begin
        if form1.opendialog1.Execute then
        begin
                if form1.ErrNum=0 then
                begin
                        try
                                assignfile(simfile,form1.opendialog1.FileName);
                        except
                                form1.ErrNum:=2;
                        end;
                        if form1.ErrNum=0 then
                        begin
                                reset(simfile);
                                for k:=0 to 23 do
                                begin
                                        readln(simfile,form1.simarray[k].cars);
                                        readln(simfile,form1.simarray[k].people);
                                end;
                               closefile(simfile);
                        end;
                end;
        end;
        if form1.ErrNum<>0 then
                DispErr(form1.ErrNum);
end;

procedure SaveData;
var
        k:integer;
        simfile:textfile;
begin
        FillSpace;
        if form1.savedialog1.Execute then
        begin
                UpdateArray;
                if form1.ErrNum=0 then
                begin
                        try
                                assignfile(simfile,form1.savedialog1.FileName);
                        except
                                form1.ErrNum:=2;
                        end;
                        if form1.ErrNum=0 then
                        begin
                                rewrite(simfile);
                                for k:=0 to 23 do
                                begin
                                        writeln(simfile,form1.simarray[k].cars);
                                        writeln(simfile,form1.simarray[k].people);
                                end;
                               closefile(simfile);
                        end;
                end
                else
                begin
                        form1.ErrNum:=k;
                end;
        end;
        //SaveData:=k;
        if form1.ErrNum<>0 then
                DispErr(form1.ErrNum);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
        k,max:integer;
begin
        for k:= 1 to 24 do
        begin
                stringgrid1.ColWidths[k]:=canvas.textwidth('999');
                stringgrid1.cells[k,0]:=inttostr(k);
        end;
        stringgrid1.cells[0,0]:='Hours';
        stringgrid1.cells[0,1]:='Cars';
        stringgrid1.cells[0,2]:='People';
        max:=canvas.textwidth(stringgrid1.Cells[0,0]);
        for k:=1 to 2 do
        begin
                if canvas.textwidth(stringgrid1.Cells[0,k])>max then
                begin
                        max:=canvas.textwidth(stringgrid1.Cells[0,k]);
                end
        end;
        stringgrid1.ColWidths[0]:=floattoint(max*1.2);
        ClearData;
end;

procedure TForm1.Save1Click(Sender: TObject);
var
        k:integer;
begin
        Savedata;
end;

procedure TForm1.Load1Click(Sender: TObject);
var
        k:integer;
begin
        Loaddata;
        UpdateDisplay;
end;

procedure TForm1.Clear1Click(Sender: TObject);
begin
        Cleardata;
end;

procedure TForm1.Maximise1Click(Sender: TObject);
begin
        form1.WindowState:=wsMinimized;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
        halt;
end;

procedure TForm1.Colours1Click(Sender: TObject);
begin
        BackupCols;
        form1.Visible:=false;
        form2.visible:=true;
end;

procedure TForm1.StringGrid1Click(Sender: TObject);
begin
        UpdateArray;
end;

end.

























unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    ColorDialog1: TColorDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  TmpCols:array[0..4] of TColor;

procedure BackupCols;

implementation

uses Unit1;

{$R *.dfm}

procedure BackupCols;
var
        k:integer;
begin
        for k:=0 to 4 do
        begin
                TmpCols[k]:=form1.Colours[k];
        end;
end;

procedure RestoreCols;
var
        k:integer;
begin
        for k:=0 to 4 do
        begin
                form1.Colours[k]:=TmpCols[k];
        end;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
        k:tcolor;
        a:boolean;
begin
        a:=ColorDialog1.Execute;
        k:=ColorDialog1.Color;
        k:=ColorDialog1.Color;
        k:=ColorDialog1.Color;
        k:=ColorDialog1.Color;
end;

procedure TForm2.Button6Click(Sender: TObject);
begin
        RestoreCols;
        form2.Visible:=false;
        form1.Visible:=true;
end;

end.